home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / telecom / 24 / comm / stv924.pas < prev    next >
Pascal/Delphi Source File  |  1986-06-19  |  18KB  |  815 lines
  1. (*
  2.  Atari 520 ST TeleVideo 924:
  3.  
  4.   a televidio 924 teZminal e^ulator (all codes that we use) for the
  5.  
  6.   atari 520 ST,
  7.  
  8.   ^ritten in Optimized Systems Software, Inc. Personal Pascal,
  9.  
  10.   by Jerry K. LaPeer of LaPeer Systems inc.
  11.  
  12.   The Atari 520ST was purchased to replace the TeleVidio series of
  13.     terminals we use on our multi - user TurboDOS z80h systems, with
  14.     the hopes of extending our TurboDOS systems with color graphics
  15.     terminals.  Well to say the least the Atari 520ST has done all
  16.     of that and promises to do even more
  17.  
  18.   The only exception to configure rs232 from the desk top is setting
  19.     the baud rate to 19.2k baud, see rsconf(0,-1,-1,-1,-1,-1); to
  20.     change this just comment out the statment and use the desk top.
  21.  
  22. *)
  23. program stv924;
  24.  
  25. const
  26.   ack =         $06;
  27.   nak =         $15;
  28.   can =         $18;
  29.   eot =         $04;
  30.  
  31.   esc =         $1b;
  32.  
  33.   modem =       1;
  34.   console =     2;
  35.  
  36.   f01_key =     $3b00;
  37.   f02_key =     $3c00;
  38.   f03_key =     $3d00;
  39.   f04_key =     $3e00;
  40.   f05_key =     $3f00;
  41.   f06_key =     $4000;
  42.   f07_key =     $4100;
  43.   f08_key =     $4200;
  44.   f09_key =     $4300;
  45.   f10_key =     $4400;
  46.   f11_key =     $5400;
  47.   f12_key =     $5500;
  48.   f13_key =     $5600;
  49.   f14_key =     $5700;
  50.   f15_key =     $5800;
  51.   f16_key =     $5900;
  52.   f17_key =     $5a00;
  53.   f18_key =     $5b00;
  54.   f19_key =     $5c00;
  55.   f20_key =     $5d00;
  56.  
  57.   help_key =    $6200;
  58.   undo_key =    $6100;
  59.  
  60.   clr_key =     $4737;
  61.   home_key =    $4700;
  62.  
  63.   ua_key =      $4800;
  64.   la_key =      $4b00;
  65.   ra_key =      $4d00;
  66.   da_key =      $5000;
  67.  
  68.   alt_skey =    $1f00;
  69.   alt_rkey =    $1300;
  70.  
  71. type
  72.   gdstrdef =    packed array[1..128] of char;
  73.   disk_buff_def = packed array[1..16384] of char;
  74.   word =        integer;
  75.  
  76. var
  77.   done:         boolean;
  78.   dtron:        boolean;
  79.   michar:       long_integer;
  80.   cichar:       long_integer;
  81.   backg_color:  integer;
  82.   forg_color:   integer;
  83.   cur_line:     integer;
  84.   cur_col:      integer;
  85.   lretcd:       long_integer;
  86.   retcd:        integer;
  87.   ifhandle:     integer;
  88.   ofhandle:     integer;
  89.   ifname:       gdstrdef;
  90.   ofname:       gdstrdef;
  91.   disk_buff:    disk_buff_def;
  92.   ndisk_buff:   integer;
  93.   reply:        char;
  94.  
  95. procedure do_send_file; forward;
  96. procedure do_receive_file; forward;
  97. procedure do_mhelp; forward;
  98.  
  99. function ci_status(device : integer) : integer;    bios(1);
  100. function schar_in(device : integer) : long_integer;bios(2);
  101. function co_status(device : integer) : integer;    bios(8);
  102. procedure char_out(device,dout : integer);         bios(3);
  103.  
  104. procedure rsconf(baud_rate,flow,ucr,p4,p5,p6 : integer); xbios(15);
  105. function cursconf(proc,op : word) : word; xbios(21);
  106. procedure offgibit(bitmask : integer); xbios(30);
  107. procedure ongibit(bitmask  : integer); xbios(29);
  108.  
  109. function create_file(var fname : gdstrdef;
  110.                          fattr : integer) :      long_integer; gemdos($3c);
  111. function delete_file(var fname : gdstrdef) :     long_integer; gemdos($41);
  112. function open_file(var fname : gdstrdef;
  113.                        fattr : integer) :        long_integer; gemdos($3d);
  114. function close_file(fhandle : integer) :         long_integer; gemdos($3e);
  115. function read_file(fhandle : integer;
  116.                    count   : long_integer;
  117.                    var dbuff : disk_buff_def) :  long_integer; gemdos($3f);
  118. function write_file(fhandle : integer;
  119.                     count   : long_integer;
  120.                     var dbuff : disk_buff_def) : long_integer; gemdos($40);
  121.  
  122. procedure set_dtr(switch : boolean);
  123.  
  124. const
  125.   dtron_mask=           $ef;
  126.   dtroff_mask=          $10;
  127.  
  128. begin
  129.  
  130.   if switch
  131.     then begin
  132.       ongibit(dtron_mask);
  133.       dtron := true;
  134.     end
  135.     else begin
  136.       offgibit(dtroff_mask);
  137.       dtron := false;
  138.     end;
  139.  
  140. end;
  141.  
  142. function char_in(device : integer) : long_integer;
  143.  
  144. begin
  145.  
  146.   if not dtron
  147.     then begin
  148.       if ci_status(modem) = 0
  149.         then set_dtr(true);
  150.     end;
  151.  
  152.   char_in := schar_in(device);
  153.  
  154. end;
  155.  
  156. procedure clear_screen;
  157.  
  158. begin
  159.  
  160.   char_out(console,esc);
  161.   char_out(console,ord('E'));
  162.  
  163.   cur_line := 1;
  164.   cur_col := 1;
  165.  
  166. end;
  167.  
  168. procedure gotoxy(row,col : char);
  169.  
  170. begin
  171.  
  172.   char_out(console,esc);
  173.   char_out(console,ord('Y'));
  174.   char_out(console,ord(row));
  175.   char_out(console,ord(col));
  176.  
  177.   cur_line := ord(row);
  178.   cur_col := ord(col);
  179.  
  180. end;
  181.  
  182. procedure do_postion_cursor;
  183.  
  184. var
  185.   row,col:      char;
  186.  
  187. begin
  188.  
  189.   row := chr(int(char_in(modem)));
  190.   col := chr(int(char_in(modem)));
  191.  
  192.   gotoxy(row,col);
  193.  
  194. end;
  195.  
  196. procedure do_char_color;
  197.  
  198. begin
  199.  
  200.   char_out(console,esc);
  201.   char_out(console,ord('c'));
  202.   char_out(console,ord(backg_color));
  203.  
  204.   char_out(console,esc);
  205.   char_out(console,ord('b'));
  206.   char_out(console,ord(forg_color));
  207.  
  208. end;
  209.  
  210. procedure do_vidio_attr;
  211.  
  212. var
  213.   data_char:            char;
  214.   data_char1:           char;
  215.  
  216. begin
  217.  
  218.   data_char := chr(int(char_in(modem)));
  219.  
  220.   case data_char of
  221.     '0'  : do_char_color;
  222.     '1'  : begin
  223.              char_out(console,esc);
  224.              char_out(console,ord('b'));
  225.              char_out(console,backg_color);
  226.            end;
  227.     '2',
  228.     '3'  : begin
  229.            end;
  230.     '4'  : begin
  231.              char_out(console,esc);
  232.              char_out(console,ord('b'));
  233.              char_out(console,forg_color);
  234.              char_out(console,esc);
  235.              char_out(console,ord('c'));
  236.              char_out(console,backg_color);
  237.            end;
  238.     '5'  : begin
  239.              char_out(console,esc);
  240.              char_out(console,ord('b'));
  241.              char_out(console,forg_color);
  242.              char_out(console,esc);
  243.              char_out(console,ord('c'));
  244.              char_out(console,forg_color);
  245.            end;
  246.     '6',
  247.     '7',
  248.     '8',
  249.     '9',
  250.     ':',
  251.     ';',
  252.     '<',
  253.     '=',
  254.     '>',
  255.     '?'  : begin
  256.            end;
  257.     ' '  : begin
  258.              char_out(console,esc);
  259.              char_out(console,ord('b'));
  260.              char_out(console,01);
  261.            end;
  262.     '$'  : begin
  263.              char_out(console,esc);
  264.              char_out(console,ord('b'));
  265.              char_out(console,01);
  266.            end;
  267.   end;
  268.  
  269. end;
  270.  
  271. procedure do_cursor_attr;
  272.  
  273. var
  274.   data_char:            char;
  275.  
  276. begin
  277.  
  278.   data_char := chr(int(char_in(modem)));
  279.  
  280.   case data_char of
  281.     '0'  : begin
  282.              char_out(console,esc);
  283.              char_out(console,ord('f'))
  284.            end;
  285.     else : begin
  286.              char_out(console,esc);
  287.              char_out(console,ord('e'))
  288.            end;
  289.   end;
  290.  
  291. end;
  292.  
  293. procedure do_eol;
  294.  
  295. begin
  296.  
  297.   char_out(console,esc);
  298.   char_out(console,ord('K'));
  299.  
  300. end;
  301.  
  302. procedure do_eos;
  303.  
  304. begin
  305.  
  306.   char_out(console,esc);
  307.   char_out(console,ord('J'));
  308.  
  309. end;
  310.  
  311. procedure do_insert;
  312.  
  313. begin
  314.  
  315.   char_out(console,esc);
  316.   char_out(console,ord('L'));
  317.  
  318. end;
  319.  
  320. procedure do_delete;
  321.  
  322. begin
  323.  
  324.   char_out(console,esc);
  325.   char_out(console,ord('M'));
  326.  
  327. end;
  328.  
  329. procedure do_light_background;
  330.  
  331. begin
  332.  
  333.   forg_color := 0;
  334.   backg_color := 2;
  335.  
  336.   do_char_color;
  337.  
  338. end;
  339.  
  340. procedure do_dark_background;
  341.  
  342. begin
  343.  
  344.   forg_color := 2;
  345.   backg_color := 0;
  346.  
  347.   do_char_color;
  348.  
  349. end;
  350.  
  351. procedure do_escape;
  352.  
  353. var
  354.   data_char:            char;
  355.  
  356. begin
  357.  
  358.   data_char := chr(int(char_in(modem)));
  359.  
  360.   case data_char of
  361.     '='  : do_postion_cursor;
  362.     'G'  : do_vidio_attr;
  363.     '.'  : do_cursor_attr;
  364.     '*'  : begin
  365.              clear_screen;
  366.              michar := char_in(modem);
  367.            end;
  368.     't',
  369.     'T'  : do_eol;
  370.     'y',
  371.     'Y'  : do_eos;
  372.     'E'  : do_insert;
  373.     'R'  : do_delete;
  374.     'b'  : do_light_background;
  375.     'd'  : do_dark_background;
  376.     else : begin
  377.              char_out(console,esc);
  378.              char_out(console,ord(data_char));
  379.            end;
  380.   end;
  381.  
  382.   if dtron then set_dtr(false);
  383.  
  384. end;
  385.  
  386. procedure do_home_cursor;
  387.  
  388. begin
  389.  
  390.   char_out(console,esc);
  391.   char_out(console,ord('H'));
  392.  
  393.   cur_line := 1;
  394.   cur_col := 1;
  395.  
  396. end;
  397.  
  398. procedure do_up_cursor;
  399.  
  400. begin
  401.  
  402.   char_out(console,esc);
  403.   char_out(console,ord('A'));
  404.  
  405. end;
  406.  
  407. procedure do_down_cursor;
  408.  
  409. begin
  410.  
  411.   char_out(console,esc);
  412.   char_out(console,ord('B'));
  413.  
  414. end;
  415.  
  416. procedure do_left_cursor;
  417.  
  418. begin
  419.  
  420.   char_out(console,esc);
  421.   char_out(console,ord('D'));
  422.  
  423. end;
  424.  
  425. procedure do_right_cursor;
  426.  
  427. begin
  428.  
  429.   char_out(console,esc);
  430.   char_out(console,ord('C'));
  431.  
  432. end;
  433.  
  434. procedure do_move_cursor;
  435.  
  436. begin
  437.  
  438.   case int(michar) of
  439.     esc  : do_escape;
  440.     $0b  : do_up_cursor;
  441.     $16  : do_down_cursor;
  442.     else : case int(michar) of
  443.       $08  : do_left_cursor;
  444.       $0c  : do_right_cursor;
  445.       $1e  : do_home_cursor;
  446.       else : begin
  447. {
  448.                if int(michar) = 13
  449.                  then cur_col := 01
  450.                  else cur_col := cur_col + 1;
  451.                if cur_col > 80
  452.                  then begin
  453.                    if dtron then set_dtr(false);
  454.                    char_out(console,13);
  455.                    char_out(console,10);
  456.                    cur_col := 1;
  457.                  end;
  458. }
  459.                char_out(console,int(michar) & $7f);
  460.              end;
  461.     end;
  462.   end;
  463.  
  464. end;
  465.  
  466. procedure do_modem_input;
  467.  
  468. begin
  469.  
  470.   michar := char_in(modem);
  471.  
  472.   case int(michar) of
  473.     $0a  : begin
  474.              if dtron then set_dtr(false);
  475.              char_out(console,int(michar));
  476.              cur_line := cur_line + 1;
  477.            end;
  478.     $1a  : clear_screen;
  479.     else : do_move_cursor;
  480.   end;
  481.  
  482. end;
  483.  
  484. procedure do_console_input;
  485.  
  486. var
  487.   data_char:            integer;
  488.  
  489.   procedure do_arrow_keys;
  490.  
  491.   begin
  492.  
  493.     case data_char of
  494.       ua_key : char_out(modem,$0b);
  495.       la_key : char_out(modem,$08);
  496.       ra_key : char_out(modem,$0c);
  497.       else   : case data_char of
  498.         da_key : char_out(modem,$16);
  499.         else   : char_out(modem,int(cichar & $000000ff));
  500.       end
  501.     end;
  502.  
  503.   end;
  504.  
  505.   procedure do_pfkeys;
  506.  
  507.   begin
  508.  
  509.     if        data_char = f01_key
  510.       then char_out(modem,$01)
  511.       else if data_char = f02_key
  512.              then char_out(modem,$03)
  513.       else if data_char = f03_key
  514.              then char_out(modem,$04)
  515.       else if data_char = f04_key
  516.              then char_out(modem,$05)
  517.       else if data_char = f05_key
  518.              then char_out(modem,$06)
  519.       else if data_char = f06_key
  520.              then char_out(modem,$0b)
  521.       else if data_char = f07_key
  522.              then char_out(modem,$0e)
  523.       else if data_char = f08_key
  524.              then char_out(modem,$0f)
  525.       else if data_char = f09_key
  526.              then char_out(modem,$11)
  527.       else if data_char = f10_key
  528.              then char_out(modem,$14)
  529.       else if data_char = f11_key
  530.              then char_out(modem,$16)
  531.       else if data_char = f12_key
  532.              then char_out(modem,$17)
  533.       else do_arrow_keys;
  534.  
  535.   end;
  536.  
  537. begin
  538.  
  539.   cichar := char_in(console);
  540.  
  541.   data_char := int((shr(cichar,8) & $ff00) | (cichar & $00ff));
  542.  
  543.   case data_char of
  544.     undo_key : begin
  545.                  done := true;
  546.                end;
  547.     help_key : begin
  548.                  do_mhelp;
  549.                end;
  550.     else : case data_char of
  551.       clr_key  : begin
  552.                    char_out(modem,$1a);
  553.                  end;
  554.       home_key : begin
  555.                    char_out(modem,$1e);
  556.                  end;
  557.       else     : begin
  558.                    if data_char = alt_skey
  559.                      then do_send_file
  560.                      else if data_char = alt_rkey
  561.                             then do_receive_file
  562.                             else do_pfkeys;
  563.                  end;
  564.     end;
  565.   end;
  566.  
  567. end;
  568.  
  569. procedure do_send_file;
  570.  
  571. var
  572.   data_char:            integer;
  573.   i:                    integer;
  574.   idelay:               integer;
  575.   sn:                   integer;
  576.   kn:                   integer;
  577.   bs:                   integer;
  578.   fname:                string[128];
  579.   hextab:               string[16];
  580.  
  581. begin
  582.  
  583.   writeln;
  584.   write('enter the send file name ');
  585.   readln(fname);
  586.  
  587.   if length(fname) > 0
  588.     then begin
  589.  
  590.       for i := 1 to length(fname) do
  591.         ifname[i] := fname[i];
  592.  
  593.       ifname[length(fname)+1] := chr($00);
  594.  
  595.       ifhandle := int(open_file(ifname,$02));
  596.  
  597.       if ifhandle < 0
  598.         then begin
  599.           writeln('couldn''t open that file! hit return');
  600.           readln(reply);
  601.           char_out(modem,can);
  602.         end
  603.         else begin
  604.  
  605.           bs := int(read_file(ifhandle,16384,disk_buff));
  606.  
  607.           if (bs mod 128) <> 0
  608.             then bs := ((bs div 128) + 1) * 128;
  609.  
  610.           ndisk_buff := 1;
  611.  
  612.           sn := 0;
  613.           kn := 0;
  614.  
  615.           hextab := '0123456789ABCDEF';
  616.  
  617.           if not dtron then set_dtr(true);
  618.  
  619.           write('sending block         ');
  620.  
  621.           char_out(modem,ack);
  622.  
  623.           while bs > ndisk_buff do begin
  624.  
  625.             for i := 1 to 128 do begin
  626.               data_char := ord(disk_buff[ndisk_buff]);
  627.               for idelay := 1 to 50 do i := i;
  628.               char_out(modem,ord(hextab[1 + (shr(data_char,4) & $000f)]));
  629.               for idelay := 1 to 50 do i := i;
  630.               char_out(modem,ord(hextab[1 + (data_char        & $000f)]));
  631.               ndisk_buff := ndisk_buff + 1;
  632.             end;
  633.  
  634.             if ndisk_buff > bs
  635.               then begin
  636.                 bs := int(read_file(ifhandle,16384,disk_buff));
  637.                 if (bs mod 128) <> 0
  638.                   then bs := ((bs div 128) + 1) * 128;
  639.                 ndisk_buff := 1;
  640.               end;
  641.  
  642.             sn := sn + 1;
  643.  
  644.             if (sn mod 8) = 0
  645.               then begin
  646.                 kn := kn + 1;
  647.                 write(chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),
  648.                       kn:8);
  649.               end;
  650.  
  651.             data_char := int(char_in(modem));
  652.  
  653.             if data_char <> ack
  654.               then bs := -1
  655.               else if bs > 0
  656.                      then char_out(modem,ack)
  657.                      else char_out(modem,eot);
  658.  
  659.           end;
  660.  
  661.           lretcd := close_file(ifhandle);
  662.  
  663.           if lretcd <> 0
  664.             then begin
  665.               writeln('couldn''t close send file! hit return');
  666.               readln(reply);
  667.             end
  668.             else begin
  669.               writeln;
  670.             end;
  671.  
  672.         end;
  673.  
  674.     end
  675.     else char_out(modem,can);
  676.  
  677. end;
  678.  
  679. procedure do_receive_file;
  680.  
  681. var
  682.   data_char:            integer;
  683.   i:                    integer;
  684.   sn:                   integer;
  685.   kn:                   integer;
  686.   fname:                string[128];
  687.  
  688. begin
  689.  
  690.   writeln;
  691.   write('enter the receive file name ');
  692.   readln(fname);
  693.  
  694.   if length(fname) > 0
  695.     then begin
  696.       for i := 1 to length(fname) do
  697.         ofname[i] := fname[i];
  698.       ofname[length(fname)+1] := chr($00);
  699.       lretcd := delete_file(ofname);
  700.       ofhandle := int(create_file(ofname,$00));
  701.       if ofhandle < 0
  702.         then begin
  703.           writeln('couldn''t create that file! hit return');
  704.           readln(reply);
  705.           char_out(modem,can);
  706.         end
  707.         else begin
  708.           ndisk_buff := 1;
  709.           sn := 0;
  710.           kn := 0;
  711.           if not dtron then set_dtr(true);
  712.           write('received block         ');
  713.           char_out(modem,ack);
  714.           repeat
  715.             for i := 1 to 128 do begin
  716.               disk_buff[ndisk_buff] := chr(int(char_in(modem)));
  717.               ndisk_buff := ndisk_buff + 1;
  718.             end;
  719.             if ndisk_buff > 16384
  720.               then begin
  721.                 lretcd := write_file(ofhandle,16384,disk_buff);
  722.                 ndisk_buff := 1;
  723.               end;
  724.             sn := sn + 1;
  725.             if (sn mod 8) = 0
  726.               then begin
  727.                 kn := kn + 1;
  728.                 write(chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),chr(8),
  729.                       kn:8);
  730.               end;
  731.             char_out(modem,ack);
  732.             data_char := int(char_in(modem));
  733.           until data_char = eot;
  734.           if ndisk_buff > 1
  735.             then lretcd := write_file(ofhandle,ndisk_buff,disk_buff);
  736.           lretcd := close_file(ofhandle);
  737.           if lretcd <> 0
  738.             then begin
  739.               writeln('couldn''t close received file! hit return');
  740.               readln(reply);
  741.             end
  742.             else begin
  743.               writeln;
  744.             end;
  745.         end;
  746.     end
  747.     else char_out(modem,can);
  748.  
  749. end;
  750.  
  751. procedure do_mhelp;
  752.  
  753. begin
  754.  
  755.   clear_screen;
  756.  
  757.   writeln('undo key    exit program.');
  758.   writeln('help key    this screen.');
  759.   writeln;
  760.   writeln('alt s key   send a file.');
  761.   writeln('alt r key   receive a file.');
  762.   writeln;
  763.   writeln('alt c key   configure rs232.');
  764.   writeln('alt d key   set defaults.');
  765.   writeln;
  766.   writeln('alt p key   phone / modem stuff');
  767.  
  768.   writeln;
  769.   write('strike any key to return');
  770.  
  771.   while ci_status(console) = 0 do;
  772.  
  773.   lretcd := char_in(console);
  774.  
  775.   clear_screen;
  776.  
  777. end;
  778.  
  779. begin
  780.  
  781.   done := false;
  782.  
  783.   retcd := cursconf(3,0);
  784.   retcd := cursconf(1,0);
  785.  
  786.   rsconf(0,-1,-1,-1,-1,-1);
  787.  
  788.   set_dtr(true);
  789.  
  790.   backg_color := 0;
  791.   forg_color := 3;
  792.  
  793.   do_char_color;
  794.  
  795.   clear_screen;
  796.  
  797.   cur_line := 1;
  798.   cur_col  := 1;
  799.  
  800.   while not done do begin
  801.     if ci_status(modem) <> 0
  802.       then do_modem_input
  803.       else if not dtron then set_dtr(true);
  804.  
  805.     if ci_status(console) <> 0
  806.       then do_console_input;
  807.  
  808.   end;
  809.  
  810.   halt;
  811.  
  812. end.
  813. 2_key =     $5500;
  814.   f13_key =     $5600;
  815.   f14_key =